home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / doorware / newsie10.zip / NEWSIE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-05  |  13KB  |  424 lines
  1. program NEWSIE ;
  2.  
  3.  (*****************************************************************)
  4.  (* This software is provided as-is, free of charge and           *)
  5.  (* includes Turbo Pascal 6.0 source code.  The source code was   *)
  6.  (* written by John Parlin and has been contributed  to  the      *)
  7.  (* public  domain  in the  interest of furthering the            *)
  8.  (* program's development but  also  to  encourage others to      *)
  9.  (* create software.                                              *)
  10.  (*                                                               *)
  11.  (* If you  add  to this program,  please  redistribute  the      *)
  12.  (* source  code as freeware to others so that they may use the   *)
  13.  (* enhancements or add even more to the program.                 *)
  14.  (*****************************************************************)
  15.  
  16. uses dos,crt ;
  17.  
  18. const
  19.    version      = '1.00 (freeware)' ;
  20.    copyright    = 'Copyright 1996 John Parlin' ;
  21.    copyright2   = 'All rights reserved' ;
  22.  
  23. type
  24.    str2         = string[2] ;
  25.  
  26. var
  27.    infile       : text ;
  28.    outfile      : text ;
  29.    line         : string ;
  30.    banner       : string ;
  31.    editor       : string ;
  32.    mouseclick   : boolean ;
  33.    mousetext    : string ;
  34.  
  35.  
  36.  (************************************************************)
  37.  (*                STRING HANDLING ROUTINES                  *)
  38.  (************************************************************)
  39.  
  40. function ChangeCase(instr:string) : string ;
  41.  
  42.  (* changes a string to uppercase alpha *)
  43.  
  44. var i : byte ;
  45. begin
  46.    for i := 1 to length(instr) do instr[i] := upcase(instr[i]);
  47.    ChangeCase:=instr
  48. end ;
  49.  
  50.  
  51. function trimright(instr:string) : string ;
  52.  
  53.  (* trims trailing spaces from the end of a string *)
  54.  
  55. begin
  56.    while (length(instr) > 0) and (instr[length(instr)] = ' ') do
  57.       instr[0] := pred(instr[0]) ;
  58.    trimright := instr
  59. end ;
  60.  
  61.  
  62. function trimleft(instr:string) : string ;
  63.  
  64.  (* trims leading spaces from the beginning of a string *)
  65.  
  66. begin
  67.    while (length(instr) > 0) and (instr[1] = ' ') do
  68.       instr := copy(instr,2,length(instr)-1) ;
  69.    trimleft := instr ;
  70. end ;
  71.  
  72.  
  73. function fixbyte(n:word) : str2 ;
  74.  
  75.  (* converts a word to a string[2] with a leading 0 in front of  *)
  76.  (* numbers lower than 10 (i.e. 1 becomes '01')                  *)
  77.  
  78. var
  79.    temp    : str2 ;
  80.    solve   : str2 ;
  81. begin
  82.    str(n,temp) ;
  83.    case n of
  84.       0..9 : solve := concat('0',temp) ;
  85.       else solve := temp ;
  86.    end ;
  87.    fixbyte := solve ;
  88. end ;
  89.  
  90.  
  91. function itoa(i:longint) : string ;
  92.  
  93.  (* converts a byte, integer, or long integer into a string *)
  94.  
  95. var
  96.    s  : string ;
  97. begin
  98.    str(i,s) ;
  99.    itoa := s ;
  100. end ;
  101.  
  102.  
  103.  (************************************************************)
  104.  (*                RIPScript Related Routines                *)
  105.  (************************************************************)
  106.  
  107. function mega(n:word) : STRING ;
  108.  
  109.  (* returns the meganumber conversion of 'n' as a string *)
  110.  (* mega numbers are used in most RipScript statements   *)
  111.  
  112. const
  113.    digits : array [0..35] of char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' ;
  114. var
  115.    i,s,d   : integer ;
  116. begin
  117.    if n < 37 then begin
  118.       mega := '0' + digits[n] ;
  119.       exit ;
  120.    end ;
  121.    i := n div 36 ;                    { how many times does 36 go into 'n' }
  122.    s := 36 * i ;                                           { sum of 36 * i }
  123.    d := n - s ;                                  { difference of 'n' - sum }
  124.    mega := digits[i] + digits[d] ;
  125. end ;
  126.  
  127.  
  128.  (************************************************************)
  129.  (*                   Other Program Routines                 *)
  130.  (************************************************************)
  131.  
  132. procedure get_config ;
  133.  
  134.  (* get program settings from NEWSIE.CFG and parse them out *)
  135.  
  136. var
  137.    configfile  : text ;
  138.    tstr,tstr2  : string ;
  139. begin
  140.    assign(configfile,'NEWSIE.CFG') ;
  141.    {$I-} reset(configfile) ; {$I+}
  142.    if ioresult <> 0 then begin
  143.       writeln ;
  144.       writeln('■ NEWSIE ERROR: Configuration file NEWSIE.CFG') ;
  145.       writeln('                file not found! See NEWSIE.DOC.') ;
  146.       halt ;
  147.    end ;
  148.    writeln('■ Reading NEWSIE.CFG') ;
  149.  
  150.    (* give the settings variables an initial value *)
  151.  
  152.    line := '' ;
  153.    editor := '' ;
  154.    banner := '' ;
  155.    mouseclick := false ;
  156.    mousetext := '^M' ;
  157.  
  158.    (* now read the config file settings *)
  159.  
  160.    while not eof(configfile) do begin
  161.       readln(configfile,line) ;
  162.       if pos('=',line) > 0 then begin
  163.          tstr := changecase(copy(line,1,pos('=',line)-1)) ;
  164.          tstr2 := copy(line,pos('=',line)+1,50) ;
  165.          tstr2 := trimleft(trimright(tstr2)) ;
  166.          if tstr = 'BANNER' then begin
  167.             if length(tstr2) > 18 then begin
  168.                writeln(#7,'■ BANNER > 18 characters!  TRUNCATING...') ;
  169.                delay(1000) ;
  170.                tstr2 := copy(tstr2,1,18) ;
  171.             end ;
  172.             banner := trimleft(trimright(tstr2)) ;
  173.          end else if tstr = 'EDITOR' then begin
  174.             editor := trimleft(trimright(tstr2)) ;
  175.          end else if tstr = 'MOUSECLICK' then begin
  176.             mouseclick := (changecase(tstr2) = 'YES') ;
  177.          end else if tstr = 'MOUSETEXT' then begin
  178.             mousetext := changecase(tstr2) ;
  179.          end ;
  180.       end ;
  181.    end ;
  182. end ;
  183.  
  184.  
  185. procedure write_banner ;
  186.  
  187.  (* creates the banner that goes onto the newspaper graphic *)
  188.  
  189. var
  190.    j,k    : integer ;
  191. begin
  192.    writeln('■ Creating banner') ;
  193.    j := length(banner) ;
  194.    j := j * 28 ;                                        {width in points}
  195.    k := 640 - j ;                              {total width - used width}
  196.    k := k div 2 ;                      {what's leftover gets cut in half}
  197.    k := trunc(k) ;
  198.    if k mod 28 <> 0 then begin              {if k is NOT divisible by 28}
  199.       repeat                                   {decrement it until it is}
  200.          dec(k) ;                            {this is to be certain that}
  201.       until k mod 28 = 0 ;          {centering of the large font is done}
  202.    end ;                                                      {correctly}
  203.  
  204.    (* The following RIP sequences are a combination of RipScript *)
  205.    (* statements and program settings from NEWSIE.CFG.  One RIP  *)
  206.    (* statement is written per-line.                             *)
  207.  
  208.    writeln(outfile,'!|Y04000700') ;
  209.    writeln(outfile,'!|c01') ;
  210.    writeln(outfile,'!|@'+mega(k)+'00'+banner) ;
  211.    writeln(outfile,'!|c00') ;
  212.    writeln(outfile,'!|L051WHD1W') ;
  213.    writeln(outfile,'!|L050GHD0G') ;
  214.    writeln(outfile,'!|Y02000300') ;
  215.    writeln(outfile,'!|@GE0810 cents') ;
  216.    writeln(outfile,'!|@0K08NEWSIE v1.00') ;
  217.    writeln(outfile,'!|c07') ;
  218.    writeln(outfile,'!|=000NLJ01') ;
  219.    writeln(outfile,'!|LHI00HI84') ;
  220.    writeln(outfile,'!|L0084HI84') ;
  221.    writeln(outfile,'!|c0F') ;
  222.    writeln(outfile,'!|L0000HI00') ;
  223.    writeln(outfile,'!|L00000084') ;
  224.    writeln(outfile,'!|Y02000400') ;
  225.    writeln(outfile,'!|c00') ;
  226. end ;
  227.  
  228.  
  229. procedure write_date ;
  230.  
  231.  (* this procedure adds today's date on the newspaper *)
  232.  
  233. const
  234.    months : array [1..12] of string[10] =
  235.             ('January','February','March','April','May','June',
  236.              'July','August','September','October','November','December') ;
  237. var
  238.    yr,mn,dt,dy : word ;
  239.    tstr        : string ;
  240. begin
  241.    getdate(yr,mn,dt,dy) ;
  242.    tstr := months[mn] + ' ' + fixbyte(dt) + ', ' + itoa(yr) ;
  243.    writeln(outfile,'!|@0A20'+tstr) ;
  244. end ;
  245.  
  246.  
  247. procedure write_editor ;
  248.  
  249.  (* this adds the "Editor in Chief" name to the newspaper *)
  250.  
  251. var
  252.    tstr   : string ;
  253.    j,k    : integer ;
  254. begin
  255.    tstr := 'Editor in Chief: '+editor ;
  256.    j := length(tstr) * 7 ;
  257.    k := 640 - j ;
  258.    writeln(outfile,'!|@'+mega(k)+'20'+tstr) ;
  259.    writeln(outfile,'!|=040GUT03') ;
  260.    writeln(outfile,'!|L052GHD2G') ;
  261.    writeln(outfile,'!|=000NLJ03') ;
  262.    writeln(outfile,'!|L5U2G5U88') ;
  263.    writeln(outfile,'!|LBO2GBO88') ;
  264.    writeln(outfile,'!|w000L270N12') ;
  265.    writeln(outfile,'!|c00') ;
  266. end ;
  267.  
  268.  
  269. procedure open_output_file ;
  270.  
  271.  (* Assigns and opens the output text file and draws the *)
  272.  (* initial newspaper.                                   *)
  273.  
  274. begin
  275.    assign(outfile,'NEWSIE.rip') ;
  276.    rewrite(outfile) ;
  277.    writeln(outfile,'!|K') ;
  278.    writeln(outfile,'!|*') ;
  279.    writeln(outfile,'!|w0010271610|W00|S0107|B0000HI84|c00|=000GUT03|c0F|=000NLJ01') ;
  280.    writeln(outfile,'!|=000NLJ03|=000NLJ03|LHI00HI84|c07|LHL03HL84|c0B|LHO06HO84') ;
  281.    writeln(outfile,'!|c07|LHQ09HQ83|c00') ;
  282. end ;
  283.  
  284.  
  285. procedure import_text ;
  286.  
  287.  (* Assigns/opens the import (input) text file NEWSIE.TXT.  Also   *)
  288.  (* parses headlines and story text and places onto the newspaper. *)
  289.  
  290. var
  291.    ts       : string ;
  292.    col      : integer ;
  293.    row      : integer ;
  294.    column   : integer ;
  295.    i        : integer ;
  296.    lastline : string ;
  297.    headline : boolean ;
  298.    line2    : string ;
  299. begin
  300.    assign(infile,'NEWSIE.txt') ;
  301.    {$I-} reset(infile) ; {$I+}
  302.    if ioresult <> 0 then begin
  303.       writeln ;
  304.       writeln(#7,'■ NEWSIE ERROR:   NEWSIE.TXT not found during') ;
  305.       writeln(   '                  import. See NEWSIE.DOC.') ;
  306.       halt(99) ;
  307.    end ;
  308.    writeln('■ Importing NEWSIE.TXT') ;
  309.    col := 10 ;                             {keeps track of current column}
  310.    row := 88 ;                                {keeps track of current row}
  311.    column := 1 ;            {keeps track of newspaper story column (1..3)}
  312.    i := 0 ;                  {this just counts the lines in the text file}
  313.    headline := false ;
  314.    lastline := '' ;
  315.    while not eof(infile) do begin
  316.       readln(infile,line) ;
  317.       line := trimleft(trimright(line)) ;
  318.       inc(i) ;
  319.       if line = '' then begin
  320.          lastline := line ;
  321.          case column of
  322.             1 : ts := mega(10) ;
  323.             2 : ts := mega(220) ;
  324.             3 : ts := mega(430) ;
  325.          end ;
  326.          writeln(outfile,'!|Y02000400') ;
  327.          writeln(outfile,'!|@'+ts+mega(row)+line) ;
  328.          row := row + 8 ;
  329.          if row >= 280 then begin
  330.             inc(column) ;
  331.             if column > 3 then begin
  332.                writeln(#7,'■ Input file too large!') ;
  333.                delay(5000) ;
  334.                exit ;
  335.             end ;
  336.             row := 88 ;
  337.          end ;
  338.       end else begin
  339.          if line[1] = ' ' then begin
  340.             line2 := copy(line,2,33) ;
  341.             headline := true ;
  342.          end else headline := false ;
  343.          if headline then begin
  344.             if (280 - row) < 48 then begin
  345.                inc(column) ;
  346.                if column > 3 then begin
  347.                   writeln(#7,'■ Input file too large!') ;
  348.                   delay(5000) ;
  349.                   exit ;
  350.                end ;
  351.                row := 88 ;
  352.             end ;
  353.             if length(line2) > 19 then line2 := copy(line2,1,19) ;
  354.             case column of
  355.                1 : ts := mega(10) ;
  356.                2 : ts := mega(220) ;
  357.                3 : ts := mega(430) ;
  358.             end ;
  359.             writeln(outfile,'!|Y01000200') ;
  360.             if (i <> 1) and (lastline[1] <> ' ') then inc(row,8) ;
  361.             writeln(outfile,'!|@'+ts+mega(row)+line2) ;
  362.             inc(row,24) ;
  363.          end else begin
  364.             if length(line) > 33 then line := copy(line,1,33) ;
  365.             case column of
  366.                1 : ts := mega(10) ;
  367.                2 : ts := mega(220) ;
  368.                3 : ts := mega(430) ;
  369.             end ;
  370.             if lastline[1] = ' ' then writeln(outfile,'!|Y02000400') ;
  371.             writeln(outfile,'!|@'+ts+mega(row)+line) ;
  372.             row := row + 8 ;
  373.          end ;
  374.          if row >= 280 then begin
  375.             inc(column) ;
  376.             if column > 3 then begin
  377.                writeln(#7,'■ Input file too large!') ;
  378.                delay(5000) ;
  379.                exit ;
  380.             end ;
  381.             row := 88 ;
  382.          end ;
  383.       end ;
  384.       lastline := line ;
  385.    end ; {while}
  386.    close(infile) ;
  387. end ;
  388.  
  389.  
  390. procedure make_mouse ;
  391.  
  392.  (* adds RIP mouse region making the entire newspaper "click-able" *)
  393.  
  394. begin
  395.    writeln('■ Adding RIP mouse region') ;
  396.    writeln(outfile,'!|1M000000HI800100000'+mousetext) ;
  397. end ;
  398.  
  399.  
  400. begin                                    (* * * M A I N   B O D Y * * *)
  401.    filemode := 66 ;
  402.    textcolor(7) ;
  403.    writeln ;
  404.    writeln('NEWSIE '+version) ;
  405.    writeln(copyright) ;
  406.    writeln(copyright2) ;
  407.    writeln ;
  408.    get_config ;
  409.    open_output_file ;
  410.    write_banner ;
  411.    write_date ;
  412.    write_editor ;
  413.    import_text ;
  414.    if mouseclick then make_mouse ;
  415.    writeln(outfile,'!|#') ;
  416.    writeln(outfile,'!|#') ;
  417.    writeln(outfile,'!|#') ;
  418.    flush(outfile) ;
  419.    close(outfile) ;
  420.    writeln('■ RIP graphic news/bulletin file NEWSIE.RIP has been created') ;
  421.    writeln('■ Bye-bye now') ;
  422.    writeln ;
  423. end.
  424.